Shareware Overload Trio 2

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / CHILD.TPX < prev next >

Wrap

Text File | 1994-03-02 | 24KB | 466 lines

#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐ #!│ CHILD.TPX │Version: 3007.105│ #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤ #!│Structure Type Description │ #!│──────────────────── ───────── ─────────────────────────────────────────│ #!│Child PROCEDURE Update a batch of child records │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Repaired CHILD Procedure │ #!│3007.105 Repaired CHILD Procedure │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #PROCEDURE(Child,'Update child records from a parent'),SCREEN,PULLDOWN #! #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐ #!│ Child │Version: 3007.105│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│ The Child template scrolls child records from a file on the screen │ #!│ and allows updating the records on the same screen. A parent │ #!│ file must be identified and a valid parent record must be in memory │ #!│ when this procedure is called. │ #!│ │ #!│ The QUEUE will contain all children records for a particular │ #!│ Parent record. Changes to the children records are made to the │ #!│ QUEUE and are only written to disk upon completion of the OK │ #!│ button. The update process is framed within a logged transaction. │ #!│ The child file must use a file driver which supports transaction │ #!│ processing in order to use this template. │ #!│ │ #!│ The Child template's screen will contain a scrolling listbox │ #!│ With Add, Change, Delete, Ok and Cancel pushbuttons and a fixed │ #!│ field entry area with Save and Exit Buttons. │ #!│ │ #!│ The Child template does not support autonumbering of keys. │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Repaired the FillQueues ROUTINE to work correctly with Multi- │ #!│ Part Keys. │ #!│3007.105 Completed support for PullDowns │ #!│ Moved the #SET of %FirstNonFixedRow from it's previous place │ #!│ inside an #IF structure, to right after the #SET of %FixRows │ #!│ Added #INSERT of StandardHeader │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #DISPLAY('') #INSERT(%StandardHeader) #PROTOTYPE('') #PROMPT('First Upd&ate Field',FIELD),%FirstUpdateField #PROMPT('Parent F&ile',FILE),%ParentFile #PROMPT('Exit on &Null Parent',CHECK),%NullParentExit #PROMPT('Upd&ate Parent on OK',CHECK),%PutParent #INSERT(%SetChildSymbols) %Procedure PROCEDURE #INSERT(%FileControl) #FIX(%File,%Primary) RecordQueue QUEUE,PRE(SAV) Line STRING(%ScreenFieldQueueSize) #<! Line to be scrolled SaveRecord LIKE(%FilePre:Record),PRE(SAV) SkipRecord BYTE #FIX(%Key,%PrimaryKey) #SET(%FirstField, %Null) #SET(%SortString,%Null) #FOR(%KeyField) #FIX(%Field,%KeyField) #IF(%FirstField = %Null) #SET(%FirstField, %KeyField) #SET(%FirstFieldSequence, %KeyFieldSequence) #ENDIF #IF(%KeyFieldSequence <> 'DESCENDING') #SET(%SortString, (CLIP(LEFT(%SortString)) & ',+SAV:' & %FieldID)) #ELSE #SET(%SortString, (CLIP(LEFT(%SortString)) & ',-SAV:' & %FieldID)) #ENDIF #ENDFOR RecordPosition STRING(256) #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) %FieldID STRING(SIZE(%Field)) #<! Restore the Memos #ENDIF #ENDFOR . #<!End Queue structure FirstPage BYTE(1) ! Page display variable EntryMode BYTE(0) ! Toggles for entry mode ScrollMode EQUATE(1) ! ScrollMode or UpdateMode EQUATE(2) ! UpdateMode DRecs SHORT ! Number of Child records QRecs SHORT ! Number of QUEUE records I BYTE ! QUEUE record pointer ChildAction BYTE(0) ! Update mode NoMoreFields BYTE(0) ! No more fields TransactionError BYTE(0) ! Transaction Error RecordEntryOne BYTE(0) ! Starting record in QUEUE %LocalData %ScreenStructure #IF(%PullDown) %PulldownStructure SAV::PullDownOpened BYTE(0) #ENDIF #EMBED('Data Section') CODE #EMBED('Setup Procedure') #INSERT(%NullParentCheck) #!Return if blank parent #INSERT(%FileControl) #INSERT(%HoldParentRecord) #!Hold the parent record OPEN(SCREEN) !Open the screen #EMBED('Setup Screen') #IF(%Pulldown) #!If a Pulldown exists OPEN(%Pulldown) #<!Open the Pulldown SAV::PullDownOpened = True #EMBED('Setup Pulldown') #! Embedded Source Code #ENDIF DO EnterScrollMode !Select Scrolling mode DO FillQueues !Fill the Queues DRecs = RECORDS(RecordQueue) !Save the number of children #FIX(%File,%Primary) DISPLAY !Show the listbox LOOP #INSERT(%GenerateFormulas) #!Generate all formulas #EMBED('Top of Accept Loop') CASE SELECTED() !Jump to setup routine OF NoMoreFields SELECT(?Save) DO EnterScrollMode ! Switch modes #INSERT(%ScreenSetupRoutines) END !End CASE ACCEPT !Accept user input CASE KEYCODE() #FOR(%HotKey) OF %HotKey #<!User defined HotKey %HotKeyProc #<!HotKey Procedure #ENDFOR END IF EntryMode = ScrollMode !If processing the ScrollMode IF RECORDS(RecordQueue) = %FixRows #<! If deleted last record. DISABLE(?Change) ! Disable the change button DISABLE(?Delete) ! Disable the delete button END ! End IF CASE FIELD() ! Jump to edit routine OF ?List ! Process the List box GET(RecordQueue,CHOICE()) #<! Get the Record Data IF ERRORCODE() THEN CYCLE. ! Cycle if no records #FIX(%File,%Primary) %FilePre:Record = SAV:SaveRecord #<! Fill the fields #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) %Field = SAV:%FieldID #<! Restore the Memos #ENDIF #ENDFOR #INSERT(%GetChildSecondary) DISPLAY ! and re-display IF KEYCODE() = MouseLeft2 ! On Mouse double click PRESS(EnterKey) ! Press the EnterKey END ! End IF OF ?Insert ! Process the Insert Button #FIX(%File,%Primary) ChildAction = AddRecord ! Set to adding a record #INSERT(%ClearFileFields) #<! Clear the record for entry #INSERT(%GetChildSecondary) DO EnterUpdateMode ! Switch to update mode #IF(%InitRoutine) #<!Field(s) initial value DO InitializeFields !Initial values from dictionary #ENDIF OF ?Change ! Process the Change Button ChildAction = ChangeRecord ! Set to Changing a record DO EnterUpdateMode ! Switch modes OF ?Delete ! Process the Delete Button ChildAction = DeleteRecord ! Set to Deleting a record DELETE(RecordQueue) ! Delete Record Queue Entry #INSERT(%ClearFileFields) #<! Clear the record for entry DISPLAY ! Redisplay the list box IF RECORDS(RecordQueue) = %FixRows #<! If deleted last record. DISABLE(?Change) ! Disable the change button DISABLE(?Delete) ! Disable the delete button SELECT(?Insert) ! Select the insert button ELSE ! Else SELECT(?List) ! Select the list box END ! End IF ChildAction = 0 ! Reset the Action CYCLE ! Cycle to accept input OF ?Ok ! Process the Ok Button QRecs = RECORDS(RecordQueue) ! Save the queue record count #FIX(%File, %Primary) #INSERT(%ClearFileFields) #<!Clear the record buffer TransactionError = 0 !Clear Transaction error #FIX(%File, %ParentFile) #FIX(%Relation,%Primary) #IF(%RelationType = '1:MANY') #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) %RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value #ENDIF #ENDFOR #ENDIF SET(%RelationKey,%RelationKey) #<!Set to the matching record LOGOUT(2,%Primary) #<!Enable transaction logging IF ERRORCODE() = BadTranErr !If transaction error occurs #INSERT(%BadTrxPrimaryMsg) SELECT(?Ok) ! Reselect the Ok button CYCLE ! Cycle to ACCEPT input END !End IF #INSERT(%UpdateChildRecords) IF TransactionError !If transaction error occurs #INSERT(%BadTrxChildMsg) ROLLBACK ! Rollback the changes. SELECT(?List,I) ! Reselect the List box PRESS(EnterKey) ! Setup to change record CYCLE ! Cycle to ACCEPT input ELSE !Else COMMIT ! Commit the changes to disk END !End IF #INSERT(%PutParentFile) DO ProcedureReturn ! Break to Return to Caller OF ?Cancel !Process the Cancel Button DO ProcedureReturn ! Break to Return to Caller END !End CASE ELSE ! Else if update mode #INSERT(%GetChildSecondary) DISPLAY ! Display the new record CASE FIELD() ! #FOR(%ScreenField) #IF(%ScreenField='?OK') #ELSIF(%ScreenField='?Cancel') #ELSIF(%ScreenField='?Save') OF ?Save ! Process the Save Button #FIX(%ScreenField,'?Save') #! Set current active to ?Save #IF(%ScreenFieldEdit) #! Check for Field Edits %ScreenFieldEdit #ENDIF CASE ChildAction ! Adding or Changing? OF AddRecord ! When adding a new record. #INSERT(%FillQueueFields) ADD(RecordQueue %SortString) #<! Add to the sorted queue ChildAction = 0 ! Reset the Action value OF ChangeRecord ! When changing a record #INSERT(%FillQueueFields) PUT(RecordQueue %SortString) #<! Add to the queue ChildAction = 0 ! Reset the Action value END ! Case SELECT(1) !Start with the first field SELECT !and cycle non-stop CYCLE !restart main process loop #ELSIF(%ScreenField='?Exit') OF ?Exit ! Process the Exit Button #FIX(%ScreenField,'?Exit') #! Set current active to ?Exit #IF(%ScreenFieldEdit) #! Check for Field Edits %ScreenFieldEdit #ENDIF DO EnterScrollMode ! Switch modes END #ELSE #INSERT(%ScreenEditRoutines) #ENDIF #ENDFOR END ! End IF CASE FIELD() #FOR(%PulldownField) #IF(%PulldownFieldProc <> %NULL) OF %PulldownField #<!For a selected menu item %PulldownFieldProc #<!Call the procedure #ENDIF #ENDFOR END !End CASE for Pulldowns END !End LOOP !───────────────────────────────────────────────────────────────────────────── ProcedureReturn ROUTINE #EMBED('Prior to Return') #IF(%Pulldown) #!If a Pulldown exists IF SAV::PullDownOpened CLOSE(%Pulldown) #<!Open the Pulldown END #ENDIF #IF(%SharedFiles) RELEASE(%ParentFile) #<!Release held parent record #ENDIF FREE(RecordQueue) !Free the QUEUE memory #EMBED('Before Closing Screen') #EMBED('Before Closing Files') #INSERT(%FileControl) DO EndOfProcedureEmbed RETURN !───────────────────────────────────────────────────────────────────────────── EndOfProcedureEmbed ROUTINE #EMBED('End of Procedure') #EMBED('Custom Routines') !───────────────────────────────────────────────────────────────────────────── #INSERT(%ChildInitFields) EnterScrollMode ROUTINE !Switch screen mode routine DISABLE(1,FIELDS()) ! Disable listbox and buttons ENABLE(?List) ! Enable the list box ENABLE(?Insert, ?Cancel) ! Enable the Buttons IF RECORDS(RecordQueue) = %FixRows #<! If no records to scroll IF EntryMode ! If not before FillQueues DISABLE(?Change) ! Disable the change button DISABLE(?Delete) ! Disable the delete button SELECT(?Insert) ! Select the insert button END ! End IF ELSE ! Else SELECT(?List) ! Select the list box END ! End IF EntryMode = ScrollMode ! Switch to scroll mode #EMBED('Enter Scroll Mode Routine') EnterUpdateMode ROUTINE EntryMode = UpdateMode !Switch screen mode routine DISABLE(1,FIELDS()) ! Disable listbox and buttons ENABLE(?%FirstUpdateField, ?Exit) #<! Enable the entry fields Select(?%FirstUpdateField) #<! Select the first entry field #EMBED('Enter Update Mode Routine') FillQueues ROUTINE FREE(RecordQueue) #<!Clear the Record queue #SET(%FixRows, '0') #SET(%ListField,'?List') #FIX(%ScreenField,%ListField) #FOR(%ScreenFieldFix) #SET(%FixRows, (%FixRows + 1)) SAV:Line = %ScreenFieldFix #<!Add list box fixed fields ADD(RecordQueue %SortString) #<! Add to the sorted queue DISPLAY(?List) #<!Blank the listbox #ENDFOR #SET(%FirstNonFixedRecord,(%FixRows+1)) #FIX(%File, %Primary) #INSERT(%ClearFileFields) #<!Clear the Child record #FIX(%File, %ParentFile) #FIX(%Relation,%Primary) #IF(%RelationType = '1:MANY') #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) %RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value #ENDIF #ENDFOR #ENDIF SET(%RelationKey,%RelationKey) #<!Set to keyed order LOOP !Get all selected records NEXT(%Primary) #<!Get the next record. IF ERRORCODE() THEN BREAK. !Quit if an error occurs #INSERT(%GetChildSecondary) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #IF(%ChildRelationField) #!If using a Range #SET(%FieldCounter,%Null) #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) #SET(%FieldCounter,(%FieldCounter+1)) #ENDIF #ENDFOR #SET(%IfWritten,%Null) #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) #IF(%FieldCounter = '1') #IF(%IfWritten) OR %RelationKeyFieldLink <> %RelationKeyField #<!If not in Range #ELSE IF %RelationKeyFieldLink <> %RelationKeyField #<!If not in Range #ENDIF #BREAK #ELSE #IF(%IfWritten) OR %RelationKeyFieldLink <> %RelationKeyField |#<!If not in Range #ELSE IF %RelationKeyFieldLink <> %RelationKeyField |#<!If not in Range #ENDIF #ENDIF #SET(%IfWritten,'TRUE') #SET(%FieldCounter,(%FieldCounter-1)) #ENDIF #ENDFOR IF RECORDS(RecordQueue) <> %FixRows #<! If records were added GET(RecordQueue,%FirstNonFixedRecord) #<! Get first non-fixed row RESET(%RelationKey,SAV:RecordPosition) #<! Reset to the last entry NEXT(%Primary) #<! Reread the last entry BREAK #<! Break out of the Loop ELSE ! Else no children found #INSERT(%ClearFileFields) #<! Clear the record BREAK #<! Break out of the Loop END ! End IF END !End IF #ENDIF #IF(%RecordFilterFormula) IF ~(%RecordFilterFormula) #<!If Filter condition not met CYCLE ! Try another record END !End IF #ELSE #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #IF(%FormulaType <> 'COMPUTED') IF ~(%FormulaCondition) #<!If Filter condition not met CYCLE ! Try another record END !End IF #ELSE IF ~(%FormulaComputation) #<!If Filter condition not met CYCLE ! Try another record END !End IF #ENDIF #ENDIF #ENDFOR #ENDIF #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'LIST') #INSERT(%GenerateFormula) #!Generate LIST formulas #ENDIF #ENDFOR #FIX(%File,%Primary) #SET(%ListField,'?LIST') #FIX(%ScreenField,%ListField) SAV:Line = %ScreenFieldExpression #<! Fill the DisplayQueue line SAV:SaveRecord = %FilePre:Record ! Save the record data SAV:RecordPosition = POSITION(%RelationKey) ! Save the record position #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) SAV:%FieldID = %Field #<! Restore the Memos #ENDIF #ENDFOR ADD(RecordQueue %SortString) #<! Add to the sorted queue IF ERRORCODE() THEN BREAK. ! Quit out if error IF FirstPage ! If page 1 IF RECORDS(RecordQueue) = ROWS(?List) ! If we have a full screen FirstPage = 0 ! turn off the page flag END ! End IF DISPLAY(?List) ! Display page 1 END ! End IF END !End LOOP IF RECORDS(RecordQueue) = %FixRows #<!If the queue is empty IF RECORDS(%Primary) #<! If file is not empty IF ?List <> %FirstEntryField #<! And list is not first SELECT(1) ! Select the first field ELSE ! Else DISABLE(1,FIELDS()) ! Disable all fields ENABLE(?Insert) ! Enable the Insert and ENABLE(?Cancel) ! the cancel buttons SELECT(?Insert) ! Select the Insert Button END ! End IF ELSE ! Else the file is empty DISABLE(1,FIELDS()) ! Disable all fields ENABLE(?Insert) ! Enable the Insert and ENABLE(?Cancel) ! the cancel buttons SELECT(?Insert) ! Select the Insert Button END ! End IF ELSE !Else records exist GET(RecordQueue,%FirstNonFixedRecord) #<! Get first non-fixed row RESET(%RelationKey,SAV:RecordPosition) #<! Reset to the last entry NEXT(%Primary) #<! Reread the last entry #INSERT(%GetChildSecondary) END !End IF DISPLAY #! #CHAIN('Report.tpx')